home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / MCL Utilities / resources.lisp < prev    next >
Encoding:
Text File  |  1990-08-31  |  21.8 KB  |  495 lines  |  [TEXT/CCL ]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;; Copyright 1990 by Ruben Kleiman for Apple Computer, Inc.
  3. ;;; Advanced Technology Group
  4. ;;;
  5. ;;;
  6.  
  7. ;;;
  8. ;;; RESOURCE MANAGEMENT UTILITIES
  9. ;;;
  10. ;;; WARNING:  This has not received heavy use, so consider it late ALPHA
  11. ;;;           and tell me about bugs (include your phone number or INTERNET
  12. ;;;           address):
  13. ;;;
  14. ;;;                     Ruben Kleiman
  15. ;;;                     Apple Computer, Inc. MS 76-3D
  16. ;;;                     20525 Mariani Avenue
  17. ;;;                     Cupertino, CA 95014
  18. ;;;
  19.  
  20. (eval-when (eval compile)
  21.   (require :traps))
  22.  
  23. ;; FUNCTION SUMMARY:
  24. ;;
  25. ;;  transfer-resource -- copy, move, delete, or modify any resource; create resource files
  26. ;;  open-resource-file -- open a resource file
  27. ;;  get-resource-handle -- get a resource
  28. ;;  get-resource-info -- get resource type, id, name and size, given its handle
  29. ;;  map-resources -- apply function over all resources of given type
  30. ;;  delete-resource -- delete a resource from its file
  31. ;;  get-unique-resource-id -- get unique id for resource of given type
  32. ;;  count-types -- returns number of resources of given type
  33. ;;  restype-from-string -- returns Macintosh ResType integers for a Lisp string naming a resource type
  34. ;;  string-from-restype -- converse of restype-from-string
  35. ;;
  36. ;;
  37.  
  38.  
  39. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  40. ;;
  41. ;;restype-from-string
  42. ;;
  43. ;;   Given a string naming a resource type, it returns two values:
  44. ;;   the high word and the low word of the resource type expected
  45. ;;   by resource manager toolbox calls.
  46. ;;   It's the inverse of string-from-restype
  47. ;;
  48. (defun restype-from-string (type)
  49.   (values (+ (* 256 (char-code (elt type 2)))
  50.              (char-code (elt type 3)))
  51.           (+ (* 256 (char-code (elt type 0)))
  52.              (char-code (elt type 1)))))
  53.  
  54. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  55. ;;
  56. ;;string-from-restype
  57. ;;
  58. ;;   Given a resource type as a long integer, returns a type string.
  59. ;;   It's the inverse of restype-from-string.
  60. ;;
  61. (defun string-from-restype (high low
  62.                                  &aux (longint (+ (* (expt 2 16) high) low))
  63.                                  (type "    ")
  64.                                  (count -1))
  65.   (mapcar #'(lambda (i)
  66.               (setf (schar type (incf count))
  67.                     (code-char (ldb (byte 8 i) longint))))
  68.           (list 8 0 24 16))
  69.   type)
  70.  
  71.  
  72.           
  73. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74. ;;
  75. ;;open-resource-file
  76. ;;
  77. ;;    Given a filename, opens its resource fork.
  78. ;;    Returns the file reference number.
  79. ;;
  80. (defun open-resource-file (filename)
  81.   (let ((tempfile (with-pstrs ((tempfile (namestring (car (directory filename)))))
  82.                     (_openresfile :errchk :ptr tempfile :word))))
  83.     (if (/= tempfile -1)
  84.       tempfile)))
  85.  
  86.  
  87. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  88. ;;
  89. ;;convert-handle-to-resource
  90. ;;
  91. ;;    Given a handle, converts it to a resource of the given type and ID.  Type must
  92. ;;    be a resource type (a four-character string) and ID a number.  If ID is not
  93. ;;    supplied, then a unique resource ID will be generated.  The optional filename
  94. ;;    should be a file into which you want the resource to be associated, else
  95. ;;    the resource will be associated with the currently opened resource file.
  96. ;;    If the supplied filename does not exist, then a file with that pathname will be created.
  97. ;;    The optional argument DELETE-OLD allows you to specify whether a resource
  98. ;;    of the same type and ID should be deleted or not if it is in the same
  99. ;;    resource file with which the new resource is to be associated.  The optional argument
  100. ;;    RESOURCE-NAME allows you to give the new resource a name; else a null string
  101. ;;    will be given.
  102. ;;
  103. (defun convert-handle-to-resource (handle type
  104.                                           &key
  105.                                           (ID (get-unique-resource-id type))
  106.                                           (filename nil)
  107.                                           (delete-old t)
  108.                                           (resource-name "")
  109.                                           &aux
  110.                                           (filerefnum nil)
  111.                                           (current-refnum (_curresfile :errchk :word))
  112.                                           (a-resource-handle nil))
  113.   (unwind-protect
  114.     (progn
  115.       ;; SET & POSSIBLE CREATE RESOURCE FILE TO WRITE TO:
  116.       (setq filerefnum
  117.             (when filename
  118.               (setq filename (expand-logical-namestring filename))
  119.               (if (probe-file filename)
  120.                 (open-resource-file filename)
  121.                 (with-pstrs ((fn filename))
  122.                   (_createresfile :errchk :ptr fn)
  123.                   (_reserror :errchk)
  124.                   (prog1 (_openresfile :errchk :ptr fn :word)
  125.                     (_reserror :errchk))))))
  126.       (or filerefnum
  127.           (setq filerefnum current-refnum))
  128.       (multiple-value-bind (type-high type-low)
  129.                            (restype-from-string type)
  130.         ;; NOW REMOVE ANY RESOURCES OF SAME TYPE & ID IN OUTPUT FILE:
  131.         (loop
  132.           (setq a-resource-handle
  133.                 (_getresource :word type-high :word type-low
  134.                               :word ID :ptr))
  135.           (_reserror :errchk)
  136.           (if (/= (_homeresfile :errchk :ptr a-resource-handle :word)
  137.                   filerefnum)
  138.             (return nil)
  139.             (if delete-old (delete-resource a-resource-handle))))
  140.         (setq a-resource-handle nil)  ; WATCH IT!
  141.         ;; NOW WE CAN ADD THE RESOURCE!
  142.         (with-pstrs ((name resource-name))
  143.           (_addresource :errchk :ptr handle
  144.                         :word type-high :word type-low
  145.                         :word ID :ptr name))
  146.         (_reserror :errchk)
  147.         (_SetResAttrs :errchk :ptr handle :word 0)
  148.         (_reserror :errchk)
  149.         (_changedresource :errchk :ptr handle)
  150.         (_reserror :errchk)
  151.         (_updateresfile :errchk :word filerefnum)
  152.         (_reserror :errchk)))
  153.     (when (/= current-refnum filerefnum)
  154.       (_useresfile :errchk :word current-refnum)
  155.       (_reserror :errchk))
  156.     (values type ID)))
  157.  
  158.                                           
  159.  
  160. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  161. ;;
  162. ;;count-Types
  163. ;;
  164. ;;   Given a resource type, returns the number of resources there are of
  165. ;;   this type in currently opened resource files.
  166. ;;
  167. (defun count-Types (type)
  168.   (multiple-value-bind (high low)
  169.                        (restype-from-string type)
  170.     (_CountResources :errchk :word high :word low :word)))
  171.  
  172.  
  173. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  174. ;;
  175. ;;map-resources
  176. ;;
  177. ;;   Given a resource type and a function, calls the
  178. ;;   FUNCTION once with each resource of that TYPE in
  179. ;;   any opened resource file or in a specific resource file.
  180. ;;   RESOURCE-FILENAME may be any particular file which you want to search.
  181. ;;   CLOSE-FILE allows you to specify whether RESOURCE-FILENAME should be
  182. ;;   closed or not after the search is over.
  183. ;;   MAKE-CURRENT allows you to designate that RESOURCE-FILENAME be made the
  184. ;;   current resource file (if CLOSE-FILE is non-nil).
  185. ;;
  186. (defun map-resources (type function &key resource-filename (close-file t) (make-current nil)
  187.                            &aux (file-refnum nil) (curresfile (_curresfile :errchk :word)))
  188.   (unwind-protect
  189.     (progn
  190.       (if (probe-file resource-filename)
  191.         (with-pstrs ((fn (expand-logical-namestring resource-filename)))
  192.           (setq file-refnum (_openresfile :errchk :ptr fn :word))
  193.           (_reserror :errchk)))
  194.       (let ((count (count-types type))
  195.             resource-handle)
  196.         (if (/= count 0)
  197.           (multiple-value-bind (high low)
  198.                                (restype-from-string type)
  199.             (dotimes (i count)
  200.               (setq resource-handle (_getindresource :word high :word low :word
  201.                                                      (1+ i) :ptr))
  202.               (unless (and file-refnum
  203.                            (/= (_homeresfile :errchk :ptr resource-handle :word)
  204.                                file-refnum))
  205.                 (_hlock :errchk :A0 resource-handle :D0)
  206.                 (funcall function resource-handle)
  207.                 (_hlock :errchk :A0 resource-handle :D0)))))))
  208.     (when (and close-file
  209.                (numberp file-refnum))
  210.       (_closeresfile :errchk :word file-refnum)
  211.       (_reserror :errchk))
  212.     (unless (and (not close-file)
  213.                  make-current)
  214.       (_useresfile :errchk :word curresfile))))
  215.  
  216.  
  217. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  218. ;;
  219. ;;get-resource-handle
  220. ;;
  221. ;;  Given the resource type and either its name or id, returns its handle.
  222. ;;  If a resource-file is provided, then that one will be used.
  223. ;;
  224. (defun get-resource-handle (type name-or-id &optional resource-file &aux old-resource-file res)
  225.   (setq old-resource-file (_curresfile :errchk :word))
  226.   (unwind-protect
  227.     (progn
  228.       (unless (and (stringp type)
  229.                    (= (length type) 4))
  230.         (error "TYPE SHOULD BE A STRING OF LENGTH 4."))
  231.       (when (and resource-file
  232.                  (probe-file resource-file)
  233.                  (setq resource-file (expand-logical-namestring resource-file)))
  234.         (with-pstrs ((fn resource-file))
  235.           (setq resource-file (_openresfile :errchk :ptr fn :word)))
  236.         (_useresfile :errchk :word resource-file))
  237.       (multiple-value-bind (high low)
  238.                            (restype-from-string type)
  239.         (cond ((stringp name-or-id)
  240.                (with-pstrs ((name name-or-id))
  241.                  (setq res (_getnamedresource :word high :word low :ptr name :ptr))))
  242.               ((numberp name-or-id)
  243.                (setq res (_getresource :word high :word low :word name-or-id :ptr)))
  244.               (t (error "A RESOURCE NAME OR ID SHOULD HAVE BEEN PROVIDED.")))))
  245.     (_useresfile :errchk :word old-resource-file)
  246.     res))
  247.  
  248.  
  249. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  250. ;;
  251. ;;get-resource-info
  252. ;;
  253. ;;   Given a resource handle, it returns the resource type, id, name and size.
  254. ;;   The type and name are Lisp strings; the id and size are numbers.
  255. ;;
  256. (defun get-resource-info (resource-handle)
  257.   (or (handlep resource-handle)
  258.       (error "~a SHOULD BE A RESOURCE HANDLE." resource-handle))
  259.   (let ((res-size (_sizeresource :errchk :ptr resource-handle :long))
  260.         res-id res-type res-name)
  261.     (_hlock :errchk :A0 resource-handle)
  262.     (unwind-protect
  263.       (%stack-block ((id 4)
  264.                      (type 8)
  265.                      (name 256))
  266.         (_getresinfo :errchk :ptr resource-handle :ptr id :ptr type :ptr name)
  267.         (_reserror :errchk)
  268.         (setq res-id (%get-word id)
  269.               res-type (string-from-restype (ldb (byte 16 0) (%get-full-long type))
  270.                                             (ldb (byte 16 16) (%get-full-long type)))
  271.               res-name (%get-string name)))
  272.       (_hunlock :errchk :A0 resource-handle))
  273.     (values res-type res-id res-name res-size)))
  274.  
  275. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  276. ;;
  277. ;;delete-resource
  278. ;;
  279. ;;   Given a resource handle, it deletes the resource in the current resource file.
  280. ;;
  281. (defun delete-resource (resource-handle)
  282.   (_rmveresource :errchk :ptr resource-handle)
  283.   (_reserror :errchk)
  284.   (_disposhandle :errchk :A0 resource-handle))
  285.  
  286.  
  287. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  288. ;;
  289. ;;get-unique-resource-id
  290. ;;
  291. ;;   Given a resource type, it returns an unique resource id for it.
  292. ;;   This id is guaranteed to be an id that
  293. ;;   is not used by an already opened resource and not an id reserved
  294. ;;   by the system.
  295. ;;
  296. (defun get-unique-resource-id (type &optional high low &aux id)
  297.   (unless (and high low)
  298.     (multiple-value-setq (high low)
  299.                          (restype-from-string type)))
  300.     (setq id (_uniqueid :errchk :word high :word low :word))
  301.     (_reserror :errchk)
  302.     (if (< -1 id 128)
  303.       (get-unique-resource-id type high low)
  304.       id))
  305.             
  306.   
  307. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  308. ;;
  309. ;;transfer-resource
  310. ;;
  311. ;;   Transfers a resource of given type and ID from resource file infile
  312. ;;   into resource file outfile.  If the optional keyword argument :infile is not provided, then
  313. ;;   the current resource file is assumed to be the infile.  If outfile
  314. ;;   does not exist, then the outfile will be created. If optional keyword argument
  315. ;;   :keep-outfile-open is non-nil, then outfile will be left in opened state
  316. ;;   (default NIL).  If optional keyword argument :delete-source is non-nil,
  317. ;;   then the source resource is deleted after the transfer.  If optional keyword
  318. ;;   argument :destination-name is provided, it will be the name given to the
  319. ;;   transfered resource in the outfile.  If the optional keyword argument
  320. ;;   :destination-id is provided, it will be the id given to the transfered
  321. ;;   resource in the outfile.  Note that you may use get-unique-resource-id
  322. ;;   to obtain an unique resource id for a resource type.
  323. ;;   You may safely use transfer-resource to change a resource's name and id
  324. ;;   in a resource file by supplying the same argument for infile and outfile.
  325. ;;   You will note that there is a variety of uses for transfer-resource.
  326. ;;
  327. (defun transfer-resource (type id outfile
  328.                                &key
  329.                                (infile nil)
  330.                                (keep-outfile-open nil)
  331.                                (delete-source nil)
  332.                                (destination-name nil)
  333.                                (destination-id nil))
  334.   (let (resource-handle       ; HANDLE TO RESOURCE TO BE COPIED
  335.         a-resource-handle     ; HANDLE TO A CONFLICTING RESOURCE WHICH MUST BE REMOVED BEFORE TRANSFER
  336.         (from-map (not infile)) ; IF THERE'S NO INFILE, THEN USE RESOURCE MAP
  337.         infile-refnum         ; INFILE REFERENCE NUMBER
  338.         created-outfile       ; FLAG: DID WE CREATE THE OUTFILE? (FOR ERROR RECOVERY)
  339.         outfile-refnum        ; OUTFILE REFERENCE NUMBER
  340.         type-high             ; HIGH TWO CHARACTERS FOR RESOURCE TYPE CODE
  341.         type-low              ; LOW TWO CHARACTERS FOR RESOURCE TYPE CODE
  342.         (old-resfile-refnum (_curresfile :errchk :word))    ; RESOURCE FILE REFERENCE NUMBER ACTIVE AT TIME OF CALL
  343.         attributes            ; FOR RESOURCE ATTRIBUTES
  344.         res-type              ; SOURCE RESOURCE TYPE
  345.         res-id                ; SOURCE RESOURCE ID
  346.         res-name              ; SOURCE RESOURCE NAME
  347.         res-size              ; SOURCE RESOURCE SIZE
  348.         ;        old-volume            ; OLD VOLUME NUMBER
  349.         ;        (default-volume 0)    ; DEFAULT VOLUME NUMBER
  350.         error s                ; FOR CATCH-ERROR-QUIETLY
  351.         )
  352.     
  353.     (multiple-value-setq (s error)
  354.                          (catch-error-quietly
  355.                            ;; CHECK ARGUMENTS, OPEN AND CREATE FILES:
  356.                            (or (and (stringp type)
  357.                                     (= (length type) 4))
  358.                                (error "RESOURCE TYPE (~S) MUST BE A STRING OF LENGTH 4." type))
  359.                            (multiple-value-setq (type-high type-low)
  360.                                                 (restype-from-string type))
  361.                            ;; OPEN/CREATE INFILE, IF NEEDED:
  362.                            (unless from-map
  363.                              (if (null (probe-file (pathname infile)))
  364.                                (error "INPUT FILE ~a NOT FOUND." infile)
  365.                                (setq infile (expand-logical-namestring infile)))
  366.                              (with-pstrs ((fn infile))
  367.                                (setq infile-refnum (_openresfile :errchk :ptr fn :word))))
  368.                            ;; OPEN OUTFILE:
  369.                            (or outfile
  370.                                (error "OUTFILE MISSING."))
  371.                            (setq outfile (expand-logical-namestring outfile))
  372.                            (with-pstrs ((fn outfile))
  373.                              (unless (probe-file outfile)
  374.                                (_createresfile :errchk :ptr fn)
  375.                                (_reserror :errchk)
  376.                                (setq created-outfile T))
  377.                              (setq outfile-refnum (_openresfile :errchk :ptr fn :word))
  378.                              (_reserror :errchk))
  379.                            
  380.                            ;; GET THE RESOURCE & CHECK ERRORS:
  381.                            (setq resource-handle
  382.                                  (_getresource :word type-high :word type-low :word id :ptr))
  383.                            (_reserror :errchk)
  384.                            (print resource-handle)
  385.                            (if (or (null resource-handle)
  386.                                    (and (not from-map)
  387.                                         (/= (_homeresfile :errchk :ptr resource-handle :word)
  388.                                             infile-refnum)))
  389.                              (error "Resource not found~@[ in file ~a~]." infile))
  390.                            
  391.                            (setq attributes (_getresattrs :errchk :ptr resource-handle :word))
  392.                            (multiple-value-setq (res-type res-id res-name res-size)
  393.                                                 (get-resource-info resource-handle))
  394.                            (_detachresource :errchk :ptr resource-handle)
  395.                            ;; IF ASKED, DELETE SOURCE RESOURCE:
  396.                            (when delete-source
  397.                              (setq a-resource-handle
  398.                                    (get-resource-handle res-type res-id))
  399.                              (delete-resource a-resource-handle)
  400.                              (setq a-resource-handle nil))
  401.                            ;; SHOULD REALLY SET THE VOLUME REFERENCE NUMBER HERE...
  402.                            (_useresfile :errchk :word outfile-refnum)
  403.                            ;; NOW REMOVE ANY RESOURCES OF SAME TYPE & ID IN OUTPUT FILE:
  404.                            (loop
  405.                              (setq a-resource-handle
  406.                                    (_getresource :word type-high :word type-low
  407.                                                  :word (or destination-id id) :ptr))
  408.                              (_reserror :errchk)
  409.                              (if (/= (_homeresfile :errchk :ptr a-resource-handle :word)
  410.                                      outfile-refnum)
  411.                                (return nil)
  412.                                (delete-resource a-resource-handle)))
  413.                            (setq a-resource-handle nil)  ; WATCH IT!
  414.                            ;; NOW WE CAN ADD THE RESOURCE!
  415.                            (with-pstrs ((name (or destination-name res-name)))
  416.                              (_addresource :errchk :ptr resource-handle
  417.                                            :word type-high :word type-low
  418.                                            :word (or destination-id id) :ptr name))
  419.                            (_reserror :errchk)
  420.                            (_SetResAttrs :errchk :ptr resource-handle :word attributes)
  421.                            (_reserror :errchk)
  422.                            (_changedresource :errchk :ptr resource-handle)
  423.                            (_reserror :errchk)
  424.                            (if keep-outfile-open
  425.                              (_writeresource :errchk :ptr resource-handle)  ; WRITE RESOURCE TO FILE
  426.                              (_closeresfile :errchk :word outfile-refnum))  ; WRITES RESOURCE, TOO
  427.                            (_reserror :errchk)
  428.                            ))
  429.     
  430.     (_UseResFile :errchk :word old-resfile-refnum)
  431.     (when error
  432.       (and created-outfile
  433.            (delete-file outfile))
  434.       (error (car s) (cadr s)))))
  435.  
  436.  
  437. (provide ':resource-manager)
  438. (pushnew ':resource-manager *modules*)
  439.     
  440.  
  441.  
  442. #| Examples:
  443.  
  444. ;; OPEN A RESOURCE FILE:
  445. (open-resource-file "ccl;foo.rsrc")
  446.  
  447. ;; HOW MANY cicn RESOURCES ARE THERE?
  448. (count-types "cicn")
  449.  
  450. ;; PRINT INFORMATION ABOUT ALL cicn RESOURCES:
  451. (map-resources "cicn" #'(lambda (h)
  452.                           (multiple-value-bind (a b c d)
  453.                                                (get-resource-info h)
  454.                             (print (list a b c d)))))
  455.  
  456. ;; PRINT INFORMATION ABOUT ALL PICT RESOURCES IN FILE "ccl;foo.rsrc"
  457. (map-resources "PICT"
  458.                #'(lambda (h)
  459.                    (multiple-value-bind (a b c d)
  460.                                         (get-resource-info h)
  461.                      (print (list a b c d))))
  462.                "ccl;foo.rsrc")
  463.                
  464. ;; GET RESOURCE HANDLE FOR THE cicn RESOURCE NAMED "Star":
  465. (get-resource-handle "cicn" "Star")
  466.  
  467. ;; GET INFORMATION ABOUT cicn RESOURCE NAMED "Star":
  468. (get-resource-info (get-resource-handle "cicn" "Star"))
  469.  
  470. ;; Copy a cicn resource id 12341 to file "big disk:foobarbaz" and name it "Neat Icon",
  471. ;; deleting any resources in the outfile of the same type and id
  472. (transfer-resource "cicn" 12341 "big disk:foobarbaz" :destination-name "Neat Icon")
  473.  
  474. ;; Check it out:
  475. (get-resource-info (get-resource-handle "cicn" "Neat Icon" "big disk:foobarbaz"))
  476.  
  477. ;; Rename the last resource to "Really Neat Icon"
  478. (transfer-resource "cicn" 12341 "big disk:foobarbaz"
  479.                    :infile "big disk:foobarbaz" 
  480.                    :destination-name "Really Neat Icon")
  481.  
  482. ;; Check it out:
  483. (get-resource-info (get-resource-handle "cicn" "Really Neat Icon" "big disk:foobarbaz"))
  484.  
  485. ;; Rename the last resource to "Excellent Icon" and change its id to 1991
  486. (transfer-resource "cicn" 12341 "big disk:foobarbaz" 
  487.                    :infile "big disk:foobarbaz" 
  488.                    :delete-source t
  489.                    :destination-id 1991
  490.                    :destination-name "Excellent Icon")
  491.  
  492. ;; Check it out:
  493. (get-resource-info (get-resource-handle "cicn" "Excellent Icon" "big disk:foobarbaz"))
  494.  
  495. |#